home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / gfa / gfaexprt.lzh / GFAXPERT.LIB / INITIO.LST < prev    next >
Encoding:
File List  |  1986-10-19  |  13.7 KB  |  565 lines
  1. ' ******************
  2. ' *** INITIO.LST ***
  3. ' ******************
  4. '
  5. DEFWRD "a-z"
  6. '
  7. > PROCEDURE coldstart
  8.   ' *** cold (= hard) reset
  9.   ' *** same as turning your computer off and on, but faster
  10.   SLPOKE &H420,0
  11.   SLPOKE &H426,0        ! probably not necessary
  12.   SLPOKE &H43A,0
  13.   ~XBIOS(38,L:LPEEK(4))
  14. RETURN
  15. ' **********
  16. '
  17. > PROCEDURE warmstart
  18.   ' *** warm (= soft) reset, probably only suitable after switching resolutions
  19.   ' *** tables in low memory (< &H93A) are not cleared
  20.   ' *** same as pressing Reset-button on your computer
  21.   ~XBIOS(38,L:LPEEK(4))
  22. RETURN
  23. ' **********
  24. '
  25. > PROCEDURE initio.system
  26.   ' *** initialise global system-variables
  27.   ' *** global : START.OS%  DISK.TOS!  NORMAL.ST!  MEGA.ST!  DRIVE!()  FLOPS
  28.   ' ***        WRITE.PROTECTED!()  RAM.END%  RAM.520!  RAM.1M!  RAM.2M!  RAM.4M!
  29.   ' ***        ST.512!  ST.1040!  HARD.DISK!  DRIVE  DRIVE$  FREE.BYTES%
  30.   LOCAL d,n,st.type
  31.   '
  32.   start.os%=LPEEK(&H4F2)
  33.   '
  34.   IF PEEK(start.os%)<>&H60
  35.     disk.tos!=TRUE
  36.   ENDIF
  37.   IF DPEEK(start.os%)=&H601E
  38.     normal.st!=TRUE
  39.   ELSE
  40.     mega.st!=TRUE
  41.   ENDIF
  42.   '
  43.   DIM drive!(16)             ! Drive!(1) = drive A, etc.
  44.   SELECT DPEEK(&H4A6)        ! first check if two drives connected
  45.   CASE 1
  46.     drive!(1)=TRUE
  47.   CASE 2
  48.     drive!(1)=TRUE
  49.     drive!(2)=TRUE
  50.   ENDSELECT
  51.   FOR n=2 TO 15
  52.     IF BTST(BIOS(10),n)
  53.       drive!(n+1)=TRUE
  54.     ENDIF
  55.   NEXT n
  56.   '
  57.   flops=PEEK(&H4A6)    ! number of floppy drives (0-2); RAM-disks not counted
  58.   '
  59.   DIM write.protected!(15)             ! (only checked for drive A)
  60.   FOR n=0 TO 15
  61.     IF drive!(n+1)
  62.       IF normal.st!
  63.         LET write.protected!(n)=(PEEK(&H9B2+n)=255)
  64.       ELSE
  65.         LET write.protected!(n)=(PEEK(&H9F8+n)=255)
  66.       ENDIF
  67.     ENDIF
  68.   NEXT n
  69.   '
  70.   ram.end%=LPEEK(&H42E)-1
  71.   IF ram.end%=&H7FFFF
  72.     ram.520!=TRUE
  73.   ENDIF
  74.   IF ram.end%=&HFFFFF
  75.     ram.1m!=TRUE
  76.   ENDIF
  77.   IF ram.end%=&H1FFFFF
  78.     ram.2m!=TRUE
  79.   ENDIF
  80.   IF ram.end%=&H3FFFFF
  81.     ram.4m!=TRUE
  82.   ENDIF
  83.   '
  84.   st.type=PEEK(&H424)
  85.   IF st.type=4
  86.     st.512!=TRUE
  87.   ENDIF
  88.   IF st.type=5
  89.     st.1040!=TRUE
  90.   ENDIF
  91.   '
  92.   IF PEEK(&H472)<>0
  93.     hard.disk!=TRUE
  94.   ENDIF
  95.   '
  96.   drive=GEMDOS(&H19)
  97.   drive$=CHR$(65+drive)
  98.   '
  99.   free.bytes%=FRE(0)
  100.   '
  101. RETURN
  102. ' **********
  103. '
  104. > PROCEDURE keyboard.version
  105.   ' *** examines keyboard-version, returns country
  106.   ' *** global :  USA.KEYBRD!  ENGLISH.KEYBRD!  GERMAN.KEYBRD!  FRENCH.KEYBRD!
  107.   SELECT PEEK(LPEEK(XBIOS(16,L:-1,L:-1,L:-1))+&H2B)
  108.   CASE &H5C
  109.     usa.keybrd!=TRUE
  110.   CASE &H23
  111.     english.keybrd!=TRUE
  112.   CASE &H7E
  113.     german.keybrd!=TRUE
  114.   CASE &H40
  115.     french.keybrd!=TRUE
  116.   ENDSELECT
  117. RETURN
  118. ' **********
  119. '
  120. > PROCEDURE initio.cursor
  121.   ' *** VT52 control codes (for TOS-screen, not to be used in a window !)
  122.   ' *** see also DEFFN.LST
  123.   cur.up$=CHR$(27)+"A"     ! cursor up
  124.   cur.dwn$=CHR$(27)+"B"    ! cursor down
  125.   cur.rgt$=CHR$(27)+"C"    ! cursor right
  126.   cur.lft$=CHR$(27)+"D"    ! cursor left
  127.   cur.home$=CHR$(27)+"H"   ! home cursor (1,1)
  128.   scroll.dwn$=CHR$(27)+"I" ! scroll screen 1 line down
  129.   cur.cls$=CHR$(27)+"J"    ! clear screen from position of cursor
  130.   cls.cur$=CHR$(27)+"d"    ! clear screen to position of cursor
  131.   cll$=CHR$(27)+"l"        ! clear line (cursor to start of cleared line)
  132.   del.line$=CHR$(27)+"M"   ! delete line (add new line at bottom of screen)
  133.   ins.line$=CHR$(27)+"L"   ! insert line
  134.   cur.cll$=CHR$(27)+"K"    ! clear line from position of cursor
  135.   cll.cur$=CHR$(27)+"o"    ! clear line to position of cursor
  136.   cur.on$=CHR$(27)+"e"     ! cursor visible
  137.   cur.off$=CHR$(27)+"f"    ! cursor invisible (still controllable)
  138.   get.cur$=CHR$(27)+"j"    ! save cursor-position
  139.   put.cur$=CHR$(27)+"k"    ! put cursor on saved position
  140.   rev.on$=CHR$(27)+"p"     ! reverse on
  141.   rev.off$=CHR$(27)+"q"    ! reverse off
  142.   wrap.on$=CHR$(27)+"v"    ! wrap on
  143.   wrap.off$=CHR$(27)+"w"   ! wrap off (chop off lines longer than screen-width)
  144. RETURN
  145. ' **********
  146. '
  147. > PROCEDURE initio.ascii.code
  148.   ' *** ASCII-codes
  149.   '
  150.   bel$=CHR$(7)
  151.   lf$=CHR$(10)
  152.   vt$=CHR$(11)
  153.   ff$=CHR$(12)
  154.   qt$=CHR$(34)
  155.   '
  156.   return$=CHR$(13)
  157.   enter$=CHR$(13)
  158.   esc$=CHR$(27)
  159.   delete$=CHR$(127)
  160.   backspace$=CHR$(8)
  161.   bs$=CHR$(8)
  162.   tab$=CHR$(9)
  163.   '
  164.   help$=CHR$(0)+CHR$(98)
  165.   undo$=CHR$(0)+CHR$(97)
  166.   insert$=CHR$(0)+CHR$(82)
  167.   clr.home$=CHR$(0)+CHR$(71)
  168.   arr.lft$=CHR$(0)+CHR$(75)
  169.   arr.rgt$=CHR$(0)+CHR$(77)
  170.   arr.up$=CHR$(0)+CHR$(72)
  171.   arr.dwn$=CHR$(0)+CHR$(80)
  172.   '
  173.   ' function-keys : see DEFFN.LST
  174.   '
  175. RETURN
  176. ' **********
  177. '
  178. > PROCEDURE initio.sprite1
  179.   ' *** make sprite Sprite1$ (use Initio.sprite2 with DATA for Sprite2$, etc.)
  180.   ' *** global :  SPRITE1$
  181.   ' *** uses Standard-Array color.index()
  182.   '
  183.   RESTORE pattern.sprite1
  184.   @make.sprite(sprite1$)
  185.   '
  186.   pattern.sprite1:
  187.   ' *** x,y,mode(0=normal;1=XOR),mask-color,sprite-color
  188.   DATA 0,0,0,0,1
  189.   ' *** mask-pattern (1 = pixel on , 0 = pixel off)
  190.   DATA 0000000000000000
  191.   DATA 0000000000000000
  192.   DATA 0000000000000000
  193.   DATA 0000000000000000
  194.   DATA 0000000000000000
  195.   DATA 0000000000000000
  196.   DATA 0000000000000000
  197.   DATA 0000000000000000
  198.   DATA 0000000000000000
  199.   DATA 0000000000000000
  200.   DATA 0000000000000000
  201.   DATA 0000000000000000
  202.   DATA 0000000000000000
  203.   DATA 0000000000000000
  204.   DATA 0000000000000000
  205.   DATA 0000000000000000
  206.   ' *** sprite-pattern
  207.   DATA 0000000000000000
  208.   DATA 0000000000000000
  209.   DATA 0000000000000000
  210.   DATA 0000000000000000
  211.   DATA 0000000000000000
  212.   DATA 0000000000000000
  213.   DATA 0000000000000000
  214.   DATA 0000000000000000
  215.   DATA 0000000000000000
  216.   DATA 0000000000000000
  217.   DATA 0000000000000000
  218.   DATA 0000000000000000
  219.   DATA 0000000000000000
  220.   DATA 0000000000000000
  221.   DATA 0000000000000000
  222.   DATA 0000000000000000
  223. RETURN
  224. ' ***
  225. > PROCEDURE make.sprite(VAR s$)
  226.   ' *** construct sprite-string from DATA
  227.   LOCAL x,y,mode,msk.color,spr.color,n,msk%,spr%,msk.pat$,spr.pat$
  228.   LOCAL msk$,spr$,pat$
  229.   CLR msk.pat$,spr.pat$,pat$
  230.   READ x,y,mode,msk.color,spr.color
  231.   FOR n=1 TO 16
  232.     READ msk$
  233.     msk%=VAL("&X"+msk$)
  234.     msk.pat$=msk.pat$+MKI$(msk%)
  235.   NEXT n
  236.   FOR n=1 TO 16
  237.     READ spr$
  238.     spr%=VAL("&X"+spr$)
  239.     spr.pat$=spr.pat$+MKI$(spr%)
  240.   NEXT n
  241.   FOR n=1 TO 16
  242.     pat$=pat$+MID$(msk.pat$,n*2-1,2)+MID$(spr.pat$,n*2-1,2)
  243.   NEXT n
  244.   s$=MKI$(x)+MKI$(y)+MKI$(mode)+MKI$(color.index(msk.color))
  245.   s$=s$+MKI$(color.index(spr.color))+pat$
  246. RETURN
  247. ' **********
  248. '
  249. > PROCEDURE initio.mouse1
  250.   ' *** make mouse-cursor Mouse1$ (use Initio.mouse2 with DATA for Mouse2$,etc.)
  251.   ' *** uses Standard-Array color.index()
  252.   ' *** global :  MOUSE1$
  253.   '
  254.   RESTORE pattern.mouse1
  255.   @make.mouse(mouse1$)
  256.   '
  257.   pattern.mouse1:
  258.   ' *** x,y,mode(0=normal;1=XOR),mask-color,mouse-color
  259.   DATA 0,0,0,0,1
  260.   ' *** mask-pattern (1 = pixel on , 0 = pixel off)
  261.   DATA 0000000000000000
  262.   DATA 0000000000000000
  263.   DATA 0000000000000000
  264.   DATA 0000000000000000
  265.   DATA 0000000000000000
  266.   DATA 0000000000000000
  267.   DATA 0000000000000000
  268.   DATA 0000000000000000
  269.   DATA 0000000000000000
  270.   DATA 0000000000000000
  271.   DATA 0000000000000000
  272.   DATA 0000000000000000
  273.   DATA 0000000000000000
  274.   DATA 0000000000000000
  275.   DATA 0000000000000000
  276.   DATA 0000000000000000
  277.   ' *** mouse-pattern
  278.   DATA 0000000000000000
  279.   DATA 0000000000000000
  280.   DATA 0000000000000000
  281.   DATA 0000000000000000
  282.   DATA 0000000000000000
  283.   DATA 0000000000000000
  284.   DATA 0000000000000000
  285.   DATA 0000000000000000
  286.   DATA 0000000000000000
  287.   DATA 0000000000000000
  288.   DATA 0000000000000000
  289.   DATA 0000000000000000
  290.   DATA 0000000000000000
  291.   DATA 0000000000000000
  292.   DATA 0000000000000000
  293.   DATA 0000000000000000
  294. RETURN
  295. ' ***
  296. > PROCEDURE make.mouse(VAR m$)
  297.   ' *** construct mouse-string from DATA
  298.   LOCAL x,y,mode,msk.color,mouse.color,n,msk%,mouse%,msk.pat$,mouse.pat$
  299.   LOCAL msk$,mouse$,pat$
  300.   CLR msk.pat$,mouse.pat$,pat$
  301.   READ x,y,mode,msk.color,mouse.color
  302.   FOR n=1 TO 16
  303.     READ msk$
  304.     msk%=VAL("&X"+msk$)
  305.     msk.pat$=msk.pat$+MKI$(msk%)
  306.   NEXT n
  307.   FOR n=1 TO 16
  308.     READ mouse$
  309.     LET mouse%=VAL("&X"+mouse$)
  310.     LET mouse.pat$=mouse.pat$+MKI$(mouse%)
  311.   NEXT n
  312.   m$=MKI$(x)+MKI$(y)+MKI$(mode)+MKI$(color.index(msk.color))
  313.   m$=m$+MKI$(color.index(mouse.color))+msk.pat$+mouse.pat$
  314. RETURN
  315. ' **********
  316. '
  317. > PROCEDURE initio.mouse
  318.   ' *** mouse-cursor
  319.   arrow.mouse=0
  320.   x.mouse=1
  321.   bee.mouse=2
  322.   finger.mouse=3
  323.   hand.mouse=4
  324.   thin.cross.mouse=5
  325.   fat.cross.mouse=6
  326.   LET open.cross.mouse=7
  327.   l.button=1                ! mouse-buttons
  328.   r.button=2
  329.   both.buttons=3
  330.   no.button=0
  331. RETURN
  332. ' **********
  333. '
  334. > PROCEDURE initio.fill1(VAR pattern$)
  335.   ' *** FILL-pattern for High (32 bytes), Medium (64) or Low (128) resolution
  336.   LOCAL bytes
  337.   bytes=32         ! 32 bytes for High resolution
  338.   '
  339.   ' *** load Fill-pattern (32 bytes for High resolution) here
  340.   INLINE fill1%,32
  341.   '
  342.   pattern$=STRING$(bytes,0)
  343.   BMOVE fill1%,V:pattern$,bytes
  344.   DEFFILL ,pattern$
  345. RETURN
  346. ' **********
  347. '
  348. > PROCEDURE initio.high.fill1
  349.   ' *** fill-pattern for High-resolution (also suitable for Medium and Low)
  350.   ' *** patterns always have a format of 16x16 pixels
  351.   ' *** global :  FILL1$
  352.   '
  353.   RESTORE high.fill1
  354.   @make.high.fill(fill1$)
  355.   '
  356.   high.fill1:
  357.   ' *** use index 0 or 1 (0=background) ; switch editor to Overwrite-mode
  358.   DATA 0000000000000000
  359.   DATA 0000000000000000
  360.   DATA 0000000000000000
  361.   DATA 0000000000000000
  362.   DATA 0000000000000000
  363.   DATA 0000000000000000
  364.   DATA 0000000000000000
  365.   DATA 0000000000000000
  366.   DATA 0000000000000000
  367.   DATA 0000000000000000
  368.   DATA 0000000000000000
  369.   DATA 0000000000000000
  370.   DATA 0000000000000000
  371.   DATA 0000000000000000
  372.   DATA 0000000000000000
  373.   DATA 0000000000000000
  374. RETURN
  375. ' ***
  376. > PROCEDURE make.high.fill(VAR fill$)
  377.   LOCAL i,pat$,pat%
  378.   CLR fill$
  379.   FOR i=1 TO 16
  380.     READ pat$
  381.     pat%=VAL("&X"+pat$)
  382.     fill$=fill$+MKI$(pat%)
  383.   NEXT i
  384. RETURN
  385. ' **********
  386. '
  387. > PROCEDURE initio.med.fill1
  388.   ' *** fill-pattern for Medium resolution (also suitable for Low resolution)
  389.   ' *** global :  FILL1$
  390.   '
  391.   RESTORE med.fill1
  392.   @make.med.fill(fill1$)
  393.   '
  394.   med.fill1:
  395.   ' *** use index 0-3 (0=background-color) ; switch editor to Overwrite-mode
  396.   ' *** (this index is the 'SETCOLOR'-index, not the VDI color-index !!)
  397.   DATA 0000000000000000
  398.   DATA 0000000000000000
  399.   DATA 0000000000000000
  400.   DATA 0000000000000000
  401.   DATA 0000000000000000
  402.   DATA 0000000000000000
  403.   DATA 0000000000000000
  404.   DATA 0000000000000000
  405.   DATA 0000000000000000
  406.   DATA 0000000000000000
  407.   DATA 0000000000000000
  408.   DATA 0000000000000000
  409.   DATA 0000000000000000
  410.   DATA 0000000000000000
  411.   DATA 0000000000000000
  412.   DATA 0000000000000000
  413. RETURN
  414. ' ***
  415. > PROCEDURE make.med.fill(VAR fill$)
  416.   LOCAL i,j,pat$,plane0%,plane1%,plane0$,plane1$
  417.   CLR fill$,plane0$,plane1$
  418.   FOR i=1 TO 16
  419.     READ pat$
  420.     CLR plane0%,plane1%
  421.     FOR j=1 TO 16
  422.       SELECT VAL(MID$(pat$,j,1))
  423.       CASE 1
  424.         plane0%=BSET(plane0%,SUB(16,j))
  425.       CASE 2
  426.         plane1%=BSET(plane1%,SUB(16,j))
  427.       CASE 3
  428.         plane0%=BSET(plane0%,SUB(16,j))
  429.         plane1%=BSET(plane1%,SUB(16,j))
  430.       ENDSELECT
  431.     NEXT j
  432.     plane0$=plane0$+MKI$(plane0%)
  433.     plane1$=plane1$+MKI$(plane1%)
  434.   NEXT i
  435.   fill$=plane0$+plane1$
  436. RETURN
  437. ' **********
  438. '
  439. > PROCEDURE initio.low.fill1
  440.   ' *** fill-pattern for Low resolution only
  441.   ' *** global :  FILL1$
  442.   '
  443.   RESTORE low.fill1
  444.   @make.low.fill(fill1$)
  445.   '
  446.   low.fill1:
  447.   ' *** use index 0-F (0=background-color) ; switch editor to Overwrite-mode
  448.   ' *** (this index is the 'SETCOLOR'-index, not the VDI color-index !!)
  449.   ' *** 0-F means you can use : 0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F (16 colors)
  450.   DATA 0000000000000000
  451.   DATA 0000000000000000
  452.   DATA 0000000000000000
  453.   DATA 0000000000000000
  454.   DATA 0000000000000000
  455.   DATA 0000000000000000
  456.   DATA 0000000000000000
  457.   DATA 0000000000000000
  458.   DATA 0000000000000000
  459.   DATA 0000000000000000
  460.   DATA 0000000000000000
  461.   DATA 0000000000000000
  462.   DATA 0000000000000000
  463.   DATA 0000000000000000
  464.   DATA 0000000000000000
  465.   DATA 0000000000000000
  466. RETURN
  467. ' ***
  468. > PROCEDURE make.low.fill(VAR fill$)
  469.   LOCAL i,j,pat$,plane0%,plane1%,plane2%,plane3%,byte|
  470.   LOCAL plane0$,plane1$,plane2$,plane3$
  471.   CLR fill$,plane0$,plane1$,plane2$,plane3$
  472.   FOR i=1 TO 16
  473.     READ pat$
  474.     CLR plane0%,plane1%,plane2%,plane3%
  475.     FOR j=1 TO 16
  476.       byte|=VAL("&H"+MID$(pat$,j,1))
  477.       IF BTST(byte|,0)
  478.         plane0%=BSET(plane0%,SUB(16,j))
  479.       ENDIF
  480.       IF BTST(byte|,1)
  481.         plane1%=BSET(plane1%,SUB(16,j))
  482.       ENDIF
  483.       IF BTST(byte|,2)
  484.         plane2%=BSET(plane2%,SUB(16,j))
  485.       ENDIF
  486.       IF BTST(byte|,3)
  487.         plane3%=BSET(plane3%,SUB(16,j))
  488.       ENDIF
  489.     NEXT j
  490.     plane0$=plane0$+MKI$(plane0%)
  491.     plane1$=plane1$+MKI$(plane1%)
  492.     plane2$=plane2$+MKI$(plane2%)
  493.     plane3$=plane3$+MKI$(plane3%)
  494.   NEXT i
  495.   fill$=plane0$+plane1$+plane2$+plane3$
  496. RETURN
  497. ' **********
  498. '
  499. > PROCEDURE initio.pattern
  500.   ' *** fill-pattterns
  501.   hollow.fill=0
  502.   solid.fill=1
  503.   pattern.fill=2
  504.   hatch.fill=3
  505. RETURN
  506. ' **********
  507. '
  508. > PROCEDURE initio.line
  509.   ' *** start/end of lines ; lines
  510.   normal.line.end=0
  511.   arrow.line.end=1
  512.   rounded.line.end=2
  513.   ' ***
  514.   normal.line=1
  515.   dash.line=2
  516.   point.line=3
  517. RETURN
  518. ' **********
  519. '
  520. > PROCEDURE initio.mark
  521.   ' *** mark-symbols
  522.   point.mark=1
  523.   plus.mark=2
  524.   star.mark=3
  525.   rectangle.mark=4
  526.   cross.mark=5
  527.   diamond.mark=6
  528. RETURN
  529. ' **********
  530. '
  531. > PROCEDURE initio.txt
  532.   ' *** text-stiles ; text-rotation
  533.   txt.normal=0
  534.   txt.bold=1
  535.   txt.light=2
  536.   txt.ital=4
  537.   txt.uline=8
  538.   txt.outline=16
  539.   ' ***
  540.   txt.0=0
  541.   txt.90=900
  542.   txt.180=1800
  543.   txt.270=2700
  544. RETURN
  545. ' **********
  546. '
  547. > PROCEDURE initio.graph
  548.   ' *** GRAPHMODE-modes
  549.   graph.replace=1
  550.   graph.transp=2
  551.   graph.xor=3
  552.   graph.rev.tr=4
  553. RETURN
  554. ' **********
  555. '
  556. > PROCEDURE initio.alert
  557.   ' *** Alert-symbols
  558.   empty.alert=0
  559.   note.alert=1
  560.   wait.alert=2
  561.   stop.alert=3
  562. RETURN
  563. ' **********
  564. '
  565.